home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textwndw.swg / 0018_Windowing Routine.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-03-26  |  2.8 KB  |  107 lines
  1. { very simple windowing routine. This allow you to define a text window with
  2. borders, and upper and lower label. The ascii code for corners and lines is
  3. the portuguese version. I'm not sure if it'll work well in the International
  4. code. If it doesn't just replace the symbols by the correct ones (also to
  5. change from double to single line border). This is freeware. No guarantees.
  6. Made by Luis Evaristo Fonseca, Thunderball Software Inc., 1994 Portugal }
  7.  
  8. { Parameters for makewindow:
  9.        (x1,y1) upper left corner coordinates;
  10.        (x2,y2) lower right corner coordinates;
  11.        ctxt    text color;
  12.        cfnd    background color (numbers bigger than 7 are blinking colors);
  13.        title   upper title (lefty);
  14.        bottom  bottom note (centered);
  15.  
  16.   Hidecursor:
  17.        Simply hides the cursor;
  18.  
  19.   Showcursor:
  20.        Makes the cursor visible again;
  21.  
  22.   Setcolor:
  23.        Changes text/back color, by changing values in textattr;
  24. }
  25.  
  26.  
  27. unit windows;
  28. interface
  29. uses crt;
  30.  
  31. procedure makewindow(x1,y1,x2,y2,ctxt,cfnd:integer;title,bottom:string);
  32. procedure hidecursor;
  33. procedure showcursor;
  34. procedure setcolor(f,b:integer);
  35.  
  36. implementation
  37.  
  38. {****************************************************************************}
  39. procedure setcolor(f,b:integer);
  40. begin
  41.     textattr := f + b * 16;
  42. end;
  43. {****************************************************************************}
  44. procedure hidecursor; assembler;
  45. asm
  46.     mov   ax,$0100
  47.     mov   cx,$2607
  48.     int   $10
  49. end;
  50. {****************************************************************************}
  51. procedure showcursor; assembler;
  52. asm
  53.     mov   ax,$0100
  54.     mov   cx,$0506
  55.     int   $10
  56. end;
  57. {****************************************************************************}
  58. procedure makewindow(x1,y1,x2,y2,ctxt,cfnd:integer;title,bottom:string);
  59. var c1,c2:integer;
  60.     sattr:byte;
  61. begin
  62.     if (x1+1>x2) or (y1+1>y2) then
  63.         exit;
  64.     sattr:=textattr;
  65.     hidecursor;
  66.     setcolor(cfnd,ctxt);
  67.     c2:=x1;
  68.     for c1:=y1 to y2 do
  69.     begin
  70.         for c2:=x1 to x2 do
  71.         begin
  72.             gotoxy(c2,c1);
  73.             write(' ');
  74.         end;
  75.     end;
  76.     gotoxy(x1,y1);
  77.     write('╔');
  78.     for c1:=x1+1 to x2-1 do
  79.         write('═');
  80.     write('╗');
  81.     for c1:=y1+1 to y2-1 do
  82.     begin
  83.         gotoxy(x1,c1);
  84.         write('║');
  85.         gotoxy(x2,c1);
  86.         write('║');
  87.     end;
  88.     gotoxy(x1,y2);
  89.     write('╚');
  90.     for c1:=x1+1 to x2-1 do
  91.         write('═');
  92.     write('╝');
  93.     if (title<>'') and (length(title)<x2-x1-4) then
  94.     begin
  95.         gotoxy(x1+1,y1);
  96.         write('╣ '+title+' ╠');
  97.     end;
  98.     if (bottom<>'') and (length(bottom)<x2-x1-9) then
  99.     begin
  100.         gotoxy(x1+((x2-x1) div 2 - length(bottom) div 2 - 2),y2);
  101.         write('╣ '+bottom+' ╠');
  102.     end;
  103.     gotoxy(x1+1,y1+1);
  104.     showcursor;
  105.     textattr:=sattr;
  106. end;
  107. end.